COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	~From here to the "END OF CTEST" message is the old file CTEST
C00005 00003	(DE GENFUNS (X)
C00006 00004	(DEFPROP VLBUG 
C00007 00005	(DEFPROP T1 
C00009 00006	~If EQQ were `EQ' then BUG1 would give the same error as BUG3 and BUG4.
C00011 00007	~This bug comes from Hearn.  It involves a variable being loaded as an 
C00013 00008	~Daryl Lewis of U.C. Irvine contributed the folling bug.
C00015 00009	~This file was recovered from Summer 71 and expanded.
C00017 00010	~This bug comes from Hearn.  It involves a variable being loaded as an 
C00020 00011	~This bug comes from John Allan.  It is a result of RSL getting
C00022 00012	(COMMENT I DON'T KNOW WHAT THIS IS - WD)
C00023 ENDMK
C⊗;
~From here to the "END OF CTEST" message is the old file CTEST
~The rest is the old file CBUGS

(DEFPROP DFUNC
         (LAMBDA (L) (LIST (Q DEFPROP) 
			   (CAADR L) 
			   (MCONS (Q LAMBDA) (CDADR L) (CDDR L)) 
			   (Q EXPR))) 
	 MACRO) 
 
(DEFPROP MCONS 
 (LAMBDA (L) 
	 (COND ((NULL (CDDR L)) (CADR L)) 
	       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L)))))) 
 MACRO) 
 
(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO) 
 
(DEFPROP EXPR0 (LAMBDA (LAS) T) EXPR)

(DEFPROP EXPR1 (LAMBDA (X) X) EXPR)
(DEFPROP FEXPR1 (LAMBDA (L) L) FEXPR)
(DEFPROP LEXPR1 (LAMBDA N N) EXPR)

(LAP SUBR1 SUBR) (POPJ P) NIL
(LAP FSUBR1 FSUBR) (POPJ P) NIL
(LAP LSUBR1 LSUBR) (JSP3 *LCALL) (POPJ P) NIL

(DFUNC (EXPR2 X Y)
       (PROG (A UPV)
	     (SETQ A X)
	     (SETQ UPV Y)
	MDT  (RETURN A)
	MDT  (GO UDT)
	     (PRINT FV)
	     (RETURN LAS)))

(DE EXPR3 (Z) (MACRO1 (FEXPR2 Z) (LEXPR2 Z) (FSUBR2 Z) (LSUBR2 Z)))
(DF FEXPR2 (L) L)
(DE LEXPR2 L L)

(LAP FSUBR2 FSUBR) (POPJ P) NIL
(LAP LSUBR2 LSUBR) (JSP 3 *LCALL) (POPJ P) NIL


(DEFPROP MACRO1 (LAMBDA (L) (CONS (Q LIST) (CDR L))) MACRO)

(DE GENFUNS (X)
 (PROG NIL
       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
       (MAPC (FUNCTION
	      (LAMBDA (Y)
	       (PROG2 (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)
		      (MAPC (FUNCTION (LAMBDA (Z) (G Z Z))) Y))))
	     (MAPC (FUNCTION (LAMBDA (W)
			      (MAPC (FUNCTION (LAMBDA (X) (F (G X)))) W)))
		   X))))

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

(DEFPROP RLOSS1
 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
 EXPR)
 
 (DEFPROP RLOSS2
	  (LAMBDA NIL
	   (AND (FUN1)
		(PROG (PROGVAR) (COND ((FUN2) (RETURN PROGVAR))))))
 	  EXPR)

 (DEFPROP RTRICKY
	  (LAMBDA NIL
	   (PROG (A) (SETQ A 1) LOOP (FOO A (SETQ A 2) (BAR)))
 	   EXPR)
 	  EXPR)

(DEFPROP T1 
 (LAMBDA (X)
  (MAPC (FUNCTION (LAMBDA (Y) (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)))
	X)) 
EXPR)
(DFUNC (T2 X Y) (T3 X Y))

(DEFPROP FOO BAR NLY)

(PRINT (QUOTE (IT IS GONE)))

(DEFPROP T3 
 (LAMBDA (X)
	 (MAPCAR (FUNCTION (LAMBDA (Y)
				   (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
					   Y)))
	 X)) 
FEXPR)

(LAP FOO SUBR)
	(POPJ P)
	NIL

(DFUNC (T4) T)

(LAP BAR FSUBR)
	(POPJ P)
	NIL

(DEFPROP HENS LAY EGGS)

(LAP BOBBY SUBR) (POPJ P) NIL 

(QUOTE (MIDDLE OF FILE))

(DEFPROP T5 
 (LAMBDA X
  (MAPCAR (FUNCTION (LAMBDA (Y) (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
	  Y))) X)) 
EXPR)

(QUOTE (END OF CTEST))

~If EQQ were `EQ' then BUG1 would give the same error as BUG3 and BUG4.
~As it is, however, it give an `(X . 13) LOSTVAR-ILOC1' error.

(DEFPROP BUG1
	 (LAMBDA (NAME)
		 (PROG (X)
		       (SETQ X
			     (APPEND
			      X
			      (PROG (&V)
			       LOOP (COND ((NOT (EQQ (SETQ X (READCH))
						     T))
					   (SETQ &V
						 (APPEND &V (LIST X))))
					  (T (RETURN &V)))
				    (GO LOOP))))))
	 EXPR)

~If NACS is set to 3 then BUG2 results in a NOAC-RESTORE error.

(DEFPROP BUG2
	 (LAMBDA NIL
		 (PROG (X)
		       (SETQ X
			     (CONS X
				   (PROG (&V)
				    LOOP (COND ((SETQ X T)
						(SETQ &V (LIST X)))
					       (T (RETURN &V)))
					 (GO LOOP))))))
	 EXPR)

~BUG3 and BUG4 both produce extra pushes and pops.

(DEFPROP BUG3 (LAMBDA NIL (PROG (X) (CONS X (COND ((SETQ X T) X))))) EXPR)

(DEFPROP BUG4 (LAMBDA (X) (PROG NIL (CONS X (COND ((SETQ X T) X))))) EXPR)

~This bug comes from Hearn.  It involves a variable being loaded as an 
~argument by an EXCH, which leaves the only copy in the AC, then protected
~by pushing which gives trouble.

~CB1 is a simple case which produces a MOVE then a MOVEM.

(DEFPROP CB1 (LAMBDA (A) (PROG (B) TAG (SETQ A A) (RETURN B))) EXPR)

~CB2 generates the erronious EXCH then stops.

(DEFPROP CB2
	 (LAMBDA (A) (PROG (B) TAG (SETQ B A) (SETQ A A) (RETURN B)))
	 EXPR)

~CB3 continues from the error of CB2 into a disaster.

(DEFPROP CB3
	 (LAMBDA (A)
		 (PROG (B)
		  TAG1 (SETQ B A)
		       (SETQ A A)
		       (COND ((FUN A B) (GO TAG3)))
		  TAG2 (RETURN B)
		  TAG3))
	 EXPR)

~Daryl Lewis of U.C. Irvine contributed the folling bug.
~The L is clobbered by the internal lambda to NIL.
~This was fixed by modification of INTERNALLAMBDA on 24July72.

(DE IRVBUG NIL (CONS L ((LAMBDA (L) NIL) NIL)))

~This bug has been patched out of the compiler by keeping varlist empty.

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

~This appeared in the course of debugging a new compiler.  An element
~of the CCLST is saved in the middle of the computation of a NOT.
~This is because the CCLST is cleared by OUTJMP but not by P2BOOL.

(DEFPROP T1 
	 (LAMBDA (X) (FUN (CAR X) (CONS (NOT X) X)))
	 EXPR)

~This file was recovered from Summer 71 and expanded.
~I believe that the bugs of RLOSS and CATEGORISE have been fixed.
~HEARNBUG is the original form of CB1,2and3 in CBUGS.
~VLBUG been patched by keeping VARLIST empty and the function has been
~copied into CBUGS.

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

(DEFPROP RLOSS 
 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
EXPR)
 
(DEFPROP CATEGORISE
 (LAMBDA NIL
  (PROG (CATEG CATEGORY)
        (PROG (&V)
         LOOP (SETQ &V
                    (AND (SETQ CATEG (QUOTE ""))
                         (PROG (&V)
                          LOOP (SETQ &V (SETQ CATEG (CAT CATEG (READCH))))
                               (COND ((SETQ CATEGORY (COMPARE (AT CATEG) CATEGLIST)) (RETURN &V))
                                     (T (GO LOOP)))))))))
EXPR)
~This bug comes from Hearn.  It involves a variable being loaded as an 
~argument by an EXCH, which leaves the only copy in the AC, then protected
~by pushing which gives trouble.

(DEFPROP HEARNBUG
 (LAMBDA (A B)
  (PROG (C E I J K M N VAR)
	(COND ((OR (ATOM B) (ATOM A)) (RETURN 1)))
	(COND ((GEQ (CDAAR A) (CDAAR B)) (GO A0)))
	(SETQ I A)
	(SETQ A B)
	(SETQ B I)
   A0	(SETQ VAR (CAAAR A))
	(SETQ M (CDAAR A))
	(SETQ N (CDAAR B))
	(SETQ A (REDLIST A))
	(SETQ B (REDLIST B))
   A1	(SETQ E (GFINV (CAR B)))
   A2	(SETQ C (GFTIMES (CAR A) E))
	(SETQ A (RPLACA A 0))
	(SETQ I (CDR A))
	(SETQ J (CDR B))
	(SETQ K 1)
   G0142(COND ((GREATERP K N) (GO A4)))
	(RPLACA I (GFDIF (CAR I) (GFTIMES C (CAR J))))
	(SETQ I (CDR I))
	(SETQ J (CDR J))
	(SETQ K (PLUS K 1))
	(GO G0142)
   A4	(COND ((NEQ (CAR A) 0) (GO A5)))
	(SETQ A (CDR A))
	(SETQ M (DIFFERENCE M 1))
	(COND ((GREATERP M 0) (GO A4)))
	(COND ((EQUAL (CAR A) 0) (GO A6)) (T (RETURN 1)))
   A5	(COND ((GEQ M N) (GO A2)))
	(SETQ I A)
	(SETQ A B)
	(SETQ B I)
	(SETQ I N)
	(SETQ N M)
	(SETQ M I)
	(GO A1)
   A6	(SETQ I B)
	(SETQ E (GFINV (CAR B)))
   A7	(RPLACA I (GFTIMES E (CAR I)))
	(COND ((SETQ I (CDR I)) (GO A7)))
	(SETQ I B)
   A8	(RPLACA I (CONS (CONS VAR N) (CAR I)))
   A9	(COND ((EQUAL (SETQ N (DIFFERENCE N 1)) 0)
	       (RETURN (PROG2 (RPLACD I
				      (COND ((EQUAL (CADR I) 0) NIL)
					    (T (CADR I))))
			      B))))
	(SETQ I (CDR I))
	(COND ((EQUAL (CAR I) 0) (GO A9)) (T (GO A8)))))
 EXPR)
~This bug comes from John Allan.  It is a result of RSL getting
~rebound in the non value boolean case.

(DEFPROP JRABUG
 (LAMBDA (X) (COND ((NULL X) (ONE)) ((MEMQ NIL X) (TWO)))) 
EXPR)

~This is a simple error in P2PROG2.  The case for test is screwed up.

(DEFPROP BLFBUG
 (LAMBDA NIL
  (PROG (HOLDL SUFF SL)
        (COND ((AND (PROG2 (SETQ SL (STRLEN SUFF))
			   (NOT (*LESS HOLDL (*PLUS SL 2))))))))) 
 EXPR)

~I found this bug in the process of debugging JRABUG and BLFBUG.
~The last occurence of G is free but is not recognized as such.
~This bug is classic dating all the way back to Blatt compilers.

(DEFPROP NEXTSYM T *FSUBR)

(DE WDBUG (XPR VALAC TEST)
 (PROG NIL
       (CLEARBOTH)
       (COND ((NOT (NULL VALAC))
	      (RETURN (PROG (CTAG RSL G)
			    (PUTPROP (SETQ G (NEXTSYM TAG)) T (QUOTE SET))
			    (BOOLEXPR XPR VALAC (CONS T G))
			    (RETURN (TESTJUMP (BOOLVALUE VALAC G)
					      TEST))))))
       (BOOLEXPR XPR VALAC TEST)
       (COND ((NULL TEST) (OUTENDTAG G)))))

(COMMENT I DON'T KNOW WHAT THIS IS - WD)

(DE P1LAM (XPR) (P1 (CONS (GENFUN (CAR XPR)) (CDR XPR))))